#
# This is a PERL source file of validation routines and help texts for
# the MACHINES databas of the Linux Counter.
#

package Validate::Machines;

use Validate;
use Validate::Common;

@ISA = qw(Validate);

%help = (
name => "The machine name. DNS name if you have one, otherwise start with ?",
country => "Country where you live. Use the 2-character ISO country code like GB or US",
purpose => "What you use this machine for. Workstation, FTP server, Web server...",
disk => "Number of megabytes of disk accessible to LINUX",
cpu => "CPU type, as Maker Type / Speed, like Intel 486SX/40",
accounts => "Number of user accounts on this system",
users => "Number of people who use this as their main system",
source => "Where and how you got Linux from, like CD/Caldera or FTP/nic.funet.fi",
distribution => "Which Linux distribution you used to install, like Slackware, Red Hat or Debian",
);

%numeric = (
"disk",1,
"accounts",1,
"users",1,
"memory",1,
	    );

sub help {
   my ($self, $field) = @_;

   return $help{$field};
}

sub check {
   my ($self, $field, $value) = @_;

   if ($field eq "name") {
       if ($value eq "") {
	   return "You cannot leave the name field blank!"
       }
   } elsif ($numeric{$field} && $value !~ /^\d+$/) {
       return "This field must contain a number"
   }
   ""; # If we get here - no error
}

sub cleanfield {
    my($self, $field, $value) = @_;
    my($lower, $origval);

    $origval = $value;
    # Generic fieldstripping: Strip quotes and trailing punctuation
    if ($value =~ /^\s*"(.*)"\s*$/) {
	$value = $1;
    }
    $value =~ s/[ \.?]+$//;
    $value =~ s/\s*\(.*\)//; # Assume parentheses contain comments only

    # The synonyms book. Note that this applies BEFORE heuristics!
    $value = mapsynonym($field, $value);
    # Tag specific stripping
    if ($field eq "country") {
	# Max length 2 uppercase chars. MAP MISSING!
	$value =~ tr/a-z/A-Z/;
	$value = substr($value, 0, 2); # Bad....
    } elsif ($field eq "distribution") {
	$value = cleandistribution($value);
    } elsif ($numeric{$field}) {
	$value =~ tr/0-9//cd;
    } elsif ($field eq "purpose") {
	$value = $self->cleancomma($field, $value);
    } elsif ($field eq "network") {
	$value = $self->cleancomma($field, $value);
    } elsif ($field eq "cpu") {
	$value = cleancpu($value);
    }
    if ($value eq "" && $origval ne "") {
	$self->notestrange($field, $origval);
    }
    $value;
}

sub cleancomma {
    my($self, $field, $value) = @_;
    my($val2, @values);
    my %list; # to make values unique
    
    if ($value =~ /,/) {
	$value =~ s/"//g; # Remove quotes - they confuse "
	@values = split(/\s*,\s*/, $value);
	for $val2 (@values) {
	    $list{$self->cleanfield($field, $val2)} = 1;
	}
	delete $list{""}; # No empty value
	# rejoin
	$value = join(", ", keys(%list));
    }
    $value;
}
	    

sub clean {
    my ($self, $rec) = @_;
    my $value = {};

    # Make recno accessible for STDERR messages in a module variable
    $current = $rec->key;

    for $field (keys(%$rec)) {
	# Skip reserved fields
	if ($field !~ /^\*/) {
	    $$value{$field} = $self->cleanfield($field, $$rec{$field});
	}
    }
    # Inter-field patching - none at present
    return $value;
}

sub notestrange {
    my($self, $field, $value) = @_;
    warn "$current: Strange value: $field $value\n";
}


# UTILITY routines - should move to its own module

sub cleanyesno {
    my $f = shift;

    if ($f =~ /^(y|yes|ja)$/i) {
	return "YES";
    } elsif ($f =~ /^(no|n)$/i) {
	return "NO";
    } else {
	return "";
    }
}

sub cleanmonthyear {
    my $f = shift;

    if ($f =~ /^(\S+) (\d+)$/) {
	$month = $1; $year = $2;
	if ($year =~ /^19../) {
	    $year -= 1900;
	}
	# Month name table lookup missing here...
	$month =~ tr/A-Z/a-z/; # match before beauty...
	return "$month $year";
    } else {
	return "";
    }
}

%distributions = (
"slackware" => "Slackware",
);		 

sub cleandistribution {
    my $value = shift;
    my $lcase;
    my $oldval = $value;

    $value =~ s/ *[\d\.,\/]* *$//; # Delete trailing version numbers
    $value =~ s/[, \+\/=-]$//; # Delete trailing strange-chars
    # Try synonyms bank again if version number was stripped
    $value = mapsynonym($field, $value) if $oldval ne $value;
    ($lcase = $value) =~ tr/A-Z/a-z/;
    if ($distributions{$lcase}) {
	$value = $distributions{$lcase};
    }
    $value;
}

# the list of normal CPU types
%cputypes =
   (
    "386SX" => "386SX",
    "386DX" => "386", # the DX is a normal 386
    "486SX" => "486SX",
    "486DX" => "486", # the DX is a normal 486
    "486DX2" => "486DX2", # these are clock-doubled
    "486dx2" => "486DX2",
    "i486DX2" => "486DX2",
    "486DX4" => "486DX4",
    "Pentium" => "Pentium",
    "pentium" => "Pentium",
    "586" => "Pentium",
    "586DX" => "Pentium",
    "P5" => "Pentium",
    "p5" => "Pentium",
    "P" => "Pentium",
    "P6" => "Pentium Pro",
    "PPro" => "Pentium Pro",
    "Ppro" => "Pentium Pro",
    "ppro" => "Pentium Pro",
    "686" => "Pentium Pro",
    );
	     

sub cleancpu {
    my $value = shift;

    # Check for perfectly OK values
    if ($value =~ /\s*\/\s*(\d+)$/) {
	$cputype = $`;
	$speed = $1;
    } elsif ($value =~ /(\d\d+)\s*(mhz|mmx)?$/i) {
	# possibly ending in a speed - require >= 2 digits
	$speed = $1;
	$cputype = $`;
	if ($speed =~ /86$/) { # against people who write "386" or "amd586"
	    $cputype .= $speed;
	    $speed = "unknown";
	} else {
	    $cputype =~ s/[- \/]$//; # remove trailing separator if any
	}
    } else {
	$cputype = $value;
	$speed = "unknown";
    }
    $cputype =~ s/Intel ?//;
    if ($cputypes{$cputype}) {
	$cputype = $cputypes{$cputype};
    } elsif ($cputype =~ /(\d86(.X)?)/) {
	$cputype = $1; # Search for the x86 family
	# and map to the Right Name
	$cputype = $cputypes{$cputype} if $cputypes{$cputype};
    }
    $value = "$cputype/$speed";
}
	
	

1;
